home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / TY2TYP.f < prev    next >
Text File  |  1992-07-31  |  2KB  |  61 lines
  1.       SUBROUTINE TY2TYP(ISN,STYP)   
  2. C! Reduces types of operand to smaller set  
  3.       include 'PARAM.h' 
  4.       include 'ALCAZA.h' 
  5.       include 'CLASS.h' 
  6.       include 'STATE.h' 
  7.       include 'USINFN.h' 
  8.       LOGICAL BTEST 
  9. C   
  10. C Here we attempt to evaluate the type of a FLOP statement  
  11. C 'name' using e.g. generic intrinsic function rules etc.   
  12. C   
  13.       CHARACTER*(*) STYP
  14.       CHARACTER*1 STYPE(7)  
  15. C I=integer R=real D=doubleprecision K=complex L=logical C=complex $=aaargh!
  16.       DATA STYPE /'I','R','D','K','L','C','$'/  
  17.       STYP = STYPE(7)   
  18.       DO 10 IR=1,NRNAME 
  19.         IF(SNAMES(ISN+ISNAME).NE.SNAMES(IR+IRNAME)) GOTO 10 
  20.         NTYP = NAMTYP(IR+IRNAME)
  21. C check for generic intrinsic function  
  22.         IF(BTEST(NTYP,16)) THEN 
  23. C marked as a function  
  24.           IFOUN = 0 
  25.           LEN = INDEX(SNAMES(IR+IRNAME),' ')-1  
  26.           DO 20 INFUN=1,LIF 
  27.             IF(CINFUN(INFUN)(:LEN).NE.SNAMES(IR+IRNAME)(:LEN)) GOTO 20  
  28.             IF(INFUNG(INFUN).EQ.0) GOTO 20  
  29. C generic function  
  30.             IFOUN = INFUN   
  31.    20     CONTINUE  
  32.           IF(IFOUN.NE.0) THEN   
  33. C? is this correct ?
  34.             STYP = CTYFUN(IFOUN)
  35.             RETURN  
  36.           ENDIF 
  37.         ENDIF   
  38.         IF(BTEST(NTYP,0)) THEN  
  39.           STYP = STYPE(1)   
  40.           RETURN
  41.         ELSE IF(BTEST(NTYP,1)) THEN 
  42.           STYP = STYPE(2)   
  43.           RETURN
  44.         ELSE IF(BTEST(NTYP,3)) THEN 
  45.           STYP = STYPE(4)   
  46.           RETURN
  47.         ELSE IF(BTEST(NTYP,4)) THEN 
  48.           STYP = STYPE(3)   
  49.           RETURN
  50.         ELSE IF(BTEST(NTYP,2)) THEN 
  51.           STYP = STYPE(5)   
  52.           RETURN
  53.         ELSE IF(BTEST(NTYP,5)) THEN 
  54.           STYP = STYPE(6)   
  55.           RETURN
  56.         ENDIF   
  57.         RETURN  
  58.    10 CONTINUE  
  59.       RETURN
  60.       END   
  61.